home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / addelt.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  11KB  |  337 lines
  1. /* addelt.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  26.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  27. } cirdat_;
  28.  
  29. #define cirdat_1 cirdat_
  30.  
  31. struct {
  32.     integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
  33.         lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
  34. } flags_;
  35.  
  36. #define flags_1 flags_
  37.  
  38. struct {
  39.     doublereal value[200000];
  40. } blank_;
  41.  
  42. #define blank_1 blank_
  43.  
  44. /*<       subroutine addelt(loce,loc,id,inodx,inodi,nnodi) >*/
  45. /* Subroutine */ int addelt_(loce, loc, id, inodx, inodi, nnodi)
  46. integer *loce, *loc, *id, *inodx, *inodi, *nnodi;
  47. {
  48.     /* Initialized data */
  49.  
  50.     static integer lnod[50] = { 10,14,16,8,15,16,15,16,13,8,18,38,27,35,8,8,
  51.         35,5,5,5,5,5,5,5,0,0,0,0,0,0,21,21,21,21,21,21,21,21,21,21,8,8,8,
  52.         8,8,0,0,0,0,0 };
  53.     static integer lval[50] = { 5,4,4,2,1,1,1,1,4,4,3,4,4,16,1,1,9,2,1,1,19,
  54.         55,17,46,0,0,0,0,0,0,1,1,1,1,1,17,17,17,17,17,1,1,1,1,1,0,0,0,0,0 
  55.         };
  56.     static integer nnods[50] = { 2,2,2,0,2,2,2,2,2,2,2,4,3,4,4,4,4,0,1,0,0,0,
  57.         0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,2,2,0,0,0,0,0,0,0 };
  58.  
  59.     /* System generated locals */
  60.     integer i_1, i_2;
  61.  
  62.     /* Local variables */
  63.     static integer itab, locp, locv;
  64.     extern /* Subroutine */ int getm4_(), copy4_(), copy8_();
  65.     static integer j, locpe, locve, nlocp, nword, jstop;
  66.     extern /* Subroutine */ int cpytb4_(), cpytb8_();
  67. #define nodplc ((integer *)&blank_1)
  68. #define cvalue ((complex *)&blank_1)
  69.     extern /* Subroutine */ int newnod_();
  70.     static integer nssnod, nlocpe, nodold, nodnew;
  71.     extern /* Subroutine */ int sizmem_();
  72.  
  73.     /* Parameter adjustments */
  74.     --inodx;
  75.     --inodi;
  76.  
  77.     /* Function Body */
  78. /*<       implicit double precision (a-h,o-z) >*/
  79.  
  80. /*     this routine adds an element to the nominal circuit definition */
  81. /* lists. */
  82.  
  83. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  84. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  85. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  86. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  87. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  88. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  89. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  90. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  91. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  92. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  93. /*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
  94. /*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
  95. /* spice version 2g.6  sccsid=flags 3/15/83 */
  96. /*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
  97. /*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
  98. /* spice version 2g.6  sccsid=blank 3/15/83 */
  99. /*<       common /blank/ value(200000) >*/
  100. /*<       integer nodplc(64) >*/
  101. /*<       complex cvalue(32) >*/
  102. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  103.  
  104. /* ... inodx(1), inodi(1) are arrays (see subckt) */
  105. /*<       dimension inodx(1),inodi(1) >*/
  106.  
  107. /*<       dimension lnod(50),lval(50),nnods(50) >*/
  108. /*<       data lnod /10,14,16, 8,15,16,15,16,13, 8, >*/
  109. /*<      1           18,38,27,35, 8, 8,35, 5, 5, 5, >*/
  110. /*<      2            5, 5, 5, 5, 0, 0, 0, 0, 0, 0, >*/
  111. /*<      3           21,21,21,21,21,21,21,21,21,21, >*/
  112. /*<      4            8, 8, 8, 8, 8, 0, 0, 0, 0, 0 / >*/
  113. /*<       data lval / 5, 4, 4, 2, 1, 1, 1, 1, 4, 4, >*/
  114. /*<      1            3, 4, 4,16, 1, 1, 9, 2, 1, 1, >*/
  115. /*<      2           19,55,17,46, 0, 0, 0, 0, 0, 0, >*/
  116. /*<      3            1, 1, 1, 1, 1,17,17,17,17,17, >*/
  117. /*<      4            1, 1, 1, 1, 1, 0, 0, 0, 0, 0 / >*/
  118. /*<       data nnods / 2, 2, 2, 0, 2, 2, 2, 2, 2, 2, >*/
  119. /*<      1             2, 4, 3, 4, 4, 4, 4, 0, 1, 0, >*/
  120. /*<      2             0, 0, 0, 0, 0, 0, 0, 0, 0, 0, >*/
  121. /*<      3             0, 0, 0, 0, 0, 0, 0, 0, 0, 0, >*/
  122. /*<      4             2, 2, 2, 0, 0, 0, 0, 0, 0, 0 / >*/
  123.  
  124. /*  copy integer part */
  125.  
  126. /*<       nword=lnod(id)-3 >*/
  127.     nword = lnod[*id - 1] - 3;
  128. /*<       if (nword.le.0) go to 10 >*/
  129.     if (nword <= 0) {
  130.     goto L10;
  131.     }
  132. /*<       call copy4(nodplc(loc+2),nodplc(loce+2),nword) >*/
  133.     copy4_(&nodplc[*loc + 1], &nodplc[*loce + 1], &nword);
  134.  
  135. /*  set nodes */
  136.  
  137. /*<    10 if (id.ge.21) go to 100 >*/
  138. L10:
  139.     if (*id >= 21) {
  140.     goto L100;
  141.     }
  142. /*<       if (nnods(id).eq.0) go to 100 >*/
  143.     if (nnods[*id - 1] == 0) {
  144.     goto L100;
  145.     }
  146. /*<       if (id.le.4) go to 20 >*/
  147.     if (*id <= 4) {
  148.     goto L20;
  149.     }
  150. /*<       if (id.le.8) go to 40 >*/
  151.     if (*id <= 8) {
  152.     goto L40;
  153.     }
  154. /*<       if (id.eq.19) go to 70 >*/
  155.     if (*id == 19) {
  156.     goto L70;
  157.     }
  158. /*<    20 jstop=nnods(id) >*/
  159. L20:
  160.     jstop = nnods[*id - 1];
  161. /*<       do 30 j=1,jstop >*/
  162.     i_1 = jstop;
  163.     for (j = 1; j <= i_1; ++j) {
  164. /*<       call newnod(nodplc(loc+j+1),nodplc(loce+j+1),inodx(1), >*/
  165. /*<      1  inodi(1),nnodi) >*/
  166.     newnod_(&nodplc[*loc + j], &nodplc[*loce + j], &inodx[1], &inodi[1], 
  167.         nnodi);
  168. /*<    30 continue >*/
  169. /* L30: */
  170.     }
  171. /*<       go to 100 >*/
  172.     goto L100;
  173. /*<    40 call newnod(nodplc(loc+2),nodplc(loce+2),inodx(1),inodi(1),nnodi) >*/
  174. L40:
  175.     newnod_(&nodplc[*loc + 1], &nodplc[*loce + 1], &inodx[1], &inodi[1], 
  176.         nnodi);
  177. /*<       call newnod(nodplc(loc+3),nodplc(loce+3),inodx(1),inodi(1),nnodi) >*/
  178.     newnod_(&nodplc[*loc + 2], &nodplc[*loce + 2], &inodx[1], &inodi[1], 
  179.         nnodi);
  180. /*<       if (id.ge.7) go to 100 >*/
  181.     if (*id >= 7) {
  182.     goto L100;
  183.     }
  184. /*<       nlocp=loc+id+1 >*/
  185.     nlocp = *loc + *id + 1;
  186. /*<       nssnod=2*nodplc(loc+4) >*/
  187.     nssnod = nodplc[*loc + 3] << 1;
  188. /*<       call getm4(nodplc(loce+id+1),nssnod) >*/
  189.     getm4_(&nodplc[*loce + *id], &nssnod);
  190. /*<       nlocpe=loce+id+1 >*/
  191.     nlocpe = *loce + *id + 1;
  192. /*<    50 do 60 j=1,nssnod >*/
  193. L50:
  194.     i_1 = nssnod;
  195.     for (j = 1; j <= i_1; ++j) {
  196. /*<       locp=nodplc(nlocp) >*/
  197.     locp = nodplc[nlocp - 1];
  198. /*<       nodold=nodplc(locp+j) >*/
  199.     nodold = nodplc[locp + j - 1];
  200. /*<       call newnod(nodold,nodnew,inodx(1),inodi(1),nnodi) >*/
  201.     newnod_(&nodold, &nodnew, &inodx[1], &inodi[1], nnodi);
  202. /*<       locpe=nodplc(nlocpe) >*/
  203.     locpe = nodplc[nlocpe - 1];
  204. /*<       nodplc(locpe+j)=nodnew >*/
  205.     nodplc[locpe + j - 1] = nodnew;
  206. /*<    60 continue >*/
  207. /* L60: */
  208.     }
  209. /*<       go to 100 >*/
  210.     goto L100;
  211. /*<    70 nlocp=loc+2 >*/
  212. L70:
  213.     nlocp = *loc + 2;
  214. /*<       call sizmem(nodplc(loc+2),nssnod) >*/
  215.     sizmem_(&nodplc[*loc + 1], &nssnod);
  216. /*<       call getm4(nodplc(loce+2),nssnod) >*/
  217.     getm4_(&nodplc[*loce + 1], &nssnod);
  218. /*<       nlocpe=loce+2 >*/
  219.     nlocpe = *loce + 2;
  220. /*<       go to 50 >*/
  221.     goto L50;
  222.  
  223. /*  copy real part */
  224.  
  225. /*<   100 if (nogo.ne.0) go to 300 >*/
  226. L100:
  227.     if (flags_1.nogo != 0) {
  228.     goto L300;
  229.     }
  230. /*<       locv=nodplc(loc+1) >*/
  231.     locv = nodplc[*loc];
  232. /*<       locve=nodplc(loce+1) >*/
  233.     locve = nodplc[*loce];
  234. /*<       call copy8(value(locv),value(locve),lval(id)) >*/
  235.     copy8_(&blank_1.value[locv - 1], &blank_1.value[locve - 1], &lval[*id - 1]
  236.         );
  237.  
  238. /*  treat non-node tables specially */
  239.  
  240. /*<   200 if (id.ge.11) go to 300 >*/
  241. /* L200: */
  242.     if (*id >= 11) {
  243.     goto L300;
  244.     }
  245. /*<       go to (300,210,220,300,230,240,230,240,260,260), id >*/
  246.     switch (*id) {
  247.     case 1:  goto L300;
  248.     case 2:  goto L210;
  249.     case 3:  goto L220;
  250.     case 4:  goto L300;
  251.     case 5:  goto L230;
  252.     case 6:  goto L240;
  253.     case 7:  goto L230;
  254.     case 8:  goto L240;
  255.     case 9:  goto L260;
  256.     case 10:  goto L260;
  257.     }
  258. /*<   210 if (nodplc(loc+4).eq.1) go to 300 >*/
  259. L210:
  260.     if (nodplc[*loc + 3] == 1) {
  261.     goto L300;
  262.     }
  263. /*<       call cpytb8(loc+7,loce+7) >*/
  264.     i_1 = *loc + 7;
  265.     i_2 = *loce + 7;
  266.     cpytb8_(&i_1, &i_2);
  267. /*<       go to 300 >*/
  268.     goto L300;
  269. /*<   220 if (nodplc(loc+4).eq.1) go to 300 >*/
  270. L220:
  271.     if (nodplc[*loc + 3] == 1) {
  272.     goto L300;
  273.     }
  274. /*<       call cpytb8(loc+10,loce+10) >*/
  275.     i_1 = *loc + 10;
  276.     i_2 = *loce + 10;
  277.     cpytb8_(&i_1, &i_2);
  278. /*<       go to 300 >*/
  279.     goto L300;
  280. /*<   230 itab=5 >*/
  281. L230:
  282.     itab = 5;
  283. /*<       go to 250 >*/
  284.     goto L250;
  285. /*<   240 itab=6 >*/
  286. L240:
  287.     itab = 6;
  288. /*<   250 if (id.le.6) go to 255 >*/
  289. L250:
  290.     if (*id <= 6) {
  291.     goto L255;
  292.     }
  293. /*<       call cpytb4(loc+itab+1,loce+itab+1) >*/
  294.     i_1 = *loc + itab + 1;
  295.     i_2 = *loce + itab + 1;
  296.     cpytb4_(&i_1, &i_2);
  297. /*<   255 call cpytb4(loc+itab+2,loce+itab+2) >*/
  298. L255:
  299.     i_1 = *loc + itab + 2;
  300.     i_2 = *loce + itab + 2;
  301.     cpytb4_(&i_1, &i_2);
  302. /*<       call cpytb8(loc+itab+3,loce+itab+3) >*/
  303.     i_1 = *loc + itab + 3;
  304.     i_2 = *loce + itab + 3;
  305.     cpytb8_(&i_1, &i_2);
  306. /*<       call cpytb8(loc+itab+4,loce+itab+4) >*/
  307.     i_1 = *loc + itab + 4;
  308.     i_2 = *loce + itab + 4;
  309.     cpytb8_(&i_1, &i_2);
  310. /*<       call cpytb4(loc+itab+5,loce+itab+5) >*/
  311.     i_1 = *loc + itab + 5;
  312.     i_2 = *loce + itab + 5;
  313.     cpytb4_(&i_1, &i_2);
  314. /*<       call cpytb8(loc+itab+6,loce+itab+6) >*/
  315.     i_1 = *loc + itab + 6;
  316.     i_2 = *loce + itab + 6;
  317.     cpytb8_(&i_1, &i_2);
  318. /*<       go to 300 >*/
  319.     goto L300;
  320. /*<   260 call cpytb8(loc+5,loce+5) >*/
  321. L260:
  322.     i_1 = *loc + 5;
  323.     i_2 = *loce + 5;
  324.     cpytb8_(&i_1, &i_2);
  325.  
  326.  
  327. /*<   300 return >*/
  328. L300:
  329.     return 0;
  330. /*<       end >*/
  331. } /* addelt_ */
  332.  
  333. #undef cvalue
  334. #undef nodplc
  335.  
  336.  
  337.